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fee a nice PNG 



# ! /usr/bin/perl 
use strict; 

#Correl_Display_l__6_l . pi 

^Designed to take the CVS formatted exported file from OmniViz and 
#image similar to that on the screen in OmniViz 
#New in Version 1.1: 
# Inclusion of clinical data!; 

use GD; 

$|=1; #Do not use output buffer - orint diag immediately 

######################## 
#Global Variable decision area: 

my %Config; #Main Configuration hash 

my $Top_Color«0 ; 

#my $Block_Size = 10; #The size (in P44cels) of each block. 

#File names: Hard Wired in version l_li 
#my $Clinical_Data_File 
Datafile (Comma delimited format) . 



#my $Output_File 
final generated image . 

#Other parameters: 
#my $Block__L,ines 
the blocks 

dimensions 
#my $Draw_Key_F 
#my $Color_Strips 
#my $Minimum 
#my $Maximum 
#my $Scale 



- 40 

B -1 
= +1 

= 5; 



« " . /Klinisch_data_i 
= " Output . png " ; 



csv" ; #The name of the Clinical 

#Name of the 



= "F" ; #Whetl 



to draw lines round the (inside) of 



#NB: Reduces/ colored area by 1 pixel in both 

= "T" ; #SHbuld a Key be prepared? 
#The number of intervening colors in the 'Strip 1 
tfAssumed^ minmum of correlation data 
#Assume6 minmum of correlation data 

#The multiplication factor for relative to $Block_Size 



of the Blocks in the Color Stripe 



######################## 
Load_Conf iguration () ,- 



#ttoad configuration from STDIN 



s testing############tf ########### 
©ARGV; #Pull filename from ARGV 



########################File accept. 
$Conf ig{Correlation_File} = shi: 

$Conf ig{Output_File} = shift ©ARC 

if ( <$Config{Correlation_File} eq/'«) or ! (-e $Conf ig{Correlation_File} ) ) #Check file 
exists (and is not blank!) 

{die "Please enter valid/correlation file name: \n'" ( $Config(Correlation_File} f " 1 
Appears to be invalid\n H ;} 
if ($Config{Output_File} eq un J 

{warn "Output filenam^ not specified: defaulting to 'Output. png 1 (all previous files 
of same name will be over written) Hit ! ! !Ctrl-C! ! ! NOW to avoid\n" ; } 



open IP_FILE, $Conf ig{Correlation_File} or #0pen input file or exit with error 

die "Cannot operr 1 " , $Conf ig{Correlation_File} , " ' \n for some reason\n" ; 

####################M##Declare useful variables######################## 
my ©IDs; / #Global - for when we find them, 

my $Row=0; / #Need this for later when loading data. 

my $Max_Col=-l; / #Used more as a security check than actually in processing, 

my ©Matrix; / #Main Matrix loaded. 

ray %Patient_ID; / #Hash array to store the patient IDs: Used to linke the CC & 

Clinical data 

############### r #########Load data from Correlation Matrix f ile###«#######tt############ 
while (<IP FI^E>) 

{ 

chomp () ; # Remove end of line char 

$ A~ s/[\n\r]//g; 
xz ($_ eq "") {next;} #In case there are any blank lines 

>unless (/\,/) {die "Errr. There is a distinct lack of commas on this line... of the 
Correl/tion_File : » " , $Conf ig{Correlation_File} , » • :\n' " ,substr ($_, 0,20) ,"....' \n" ; } 

/ my ©Fields = split (",",$_); #Split on Commas (it is a Comma delimited file) ; 
if (/^Variables/) #Ie. The first line with the "names" of the 

rows/colums . 

{ 

shift ©Fields; #Strip the 'Variables 1 part off. 
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scoped 



print "©FieldsVn" ,- 
©IDs = ©Fields; 



#Take of copy of the ' ©Fields' Array which is Locally 



line . 



next; #Skip to next line 
} 

my $Patient_ID = shift ©Fields; #Strip the 'Patient' part off the front j6£ each 

print "D: Loading CC data for patient ID: ' $Patient_ID » \n" ; 
$Patient_ID{$Row} = $Patient_ID; 
if ($Patient_ID =~ m/b$/) 

{ 

print "D: Detected 'b« suffix Patient: 1 $Patient_ID • 
$Patient_ID =~ s/b$//; 
print '» ' $Patient_ID* \n" ; 
} 

if ($#Fields ■ = $Max_Col) 
{ 

if ($Max_Col == -1) 
{ 



#Check consistent number of 




ected to : n ; 



else 



$Max_Col = $#Fields; #Wasteful to do this every time., 
print "D : Setting Max_Col to: » $Max_C6T • \n « ; 

} 
{ 



print "D: Warning: Number of Colpums Deviation: Row '$Row' (has 
' $#Fields 1 coloums, previous ones had 1 $Max_Col 1 \n" ; 

} 

} 



foreach my $C_Col (0 . . $#Fields) 



$Row++ ; 

} 



{ 

$Matrix[$Row] [$C_Col] = $Field3'[$C_Col] ,- 



print "D : 
print "D : 
print "D : 
D: Matrix 
print "D: 
open CLIN 
die 



Matrix is: [Rows x Coloums] : $R*ow x $Max_Col\n" ; 

Or to put it another way: $if Matrix, » x » , $#{ $Matrix [0] } , "\n» ; 

Matrix Test cell = 0,0 = $Ma/rix[0] [0] \n D: Matrix Test cell 1,0 = $Matri^c[l] [03 
Test cell 303,303 = $Matrix/302] [302] \n" ; 

We are using clinical data/file: ' $Conf ig{Clinical_Data_File} ' \n" ; 

Datla_File} or 

itaf ile : 1 ■ , $Conf ig{Clinical_Data_File} , " 



FILE , $Conf ig { Clinical J 
"Cannot open clinical 



for some 



reason\n" ; 
my $Clinical_pata_Col_HeaderJTextf_l 
my $Clinical_Data_Col_Header_Text_2 
my $Clinical_Data_Col_Header Te^>ct_3 
my $Clinica l_pa t a_Co l_He ade r _JTex t_4 
my $Clinical_Data_Col_Header£Text_5 
my $Clinical_Data_Col_Heade l r'_Text_6 
my $Clinical_Data_Col_Headj3r_Text_7 
my $Clinica l_Da t a_Col _He ap e r_Text _8 
my $Clinical_Data_Col_He£der_Text_9 
my $Wanted_Header_Col_lndex__l 
my $Wanted_Header_Col /Index_2 
my $ Wan t e d_He ade r_Col/_I ndex_3 
my $Wanted_Header_Cod__Index__4 
my $ Want ed__He ade r_Col_lndex_5 
my $Wanted_Header/Col_Index__6 
my $Wanted_Heade£col_Index_7 
my $Wanted_Header_Col_Index_8 
my $Wanted__Heaaer_Col_Index_9 
my %Classif ication_l ; 
my %Classif ication_2 ; 
my %Classifacation_3 ; 
my %Classi^r ication_4 ; 
my %Classif ication_5 ; 
my %Classif ication_6 ; 
my %Classif ication_7 ; 
my %Classif ication 8 ; 



7 
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my %Classif ication_9; 
while (<CL,IN_FILE>) 

{ 

chomp (); #Death to New Line characters 1 (;-) 

unless (A»/> {die "Errr. There is a distinct lack of commas on this line... of the 

Correlation_File: * » , $Conf ig{Correlation_File} , " 1 :\n"\ substr ($_, 0, 20) , " »\n» ; } 

my ©Fields - split (",",$_); 

if (/^Volgnummer/) #Match the Header line: 
{ 

print »D: , $_ , \n»; 

# @Clinical_Data_Col_Headers = ©Fields; #i.e. jusj^copy the comma-split 

line 

#Run through all column headers to find the index of the one we a/e looking for: 

foreach my $C_Column (0.. scalar (©Fields)) 

if ($Fields [$C_Column] eq $Conf ig{Heade£_Col_l} ) #Scan across the 
header line for column we want #1 

{ #Whoppie ! Found the jrfne we want ! 

$Wanted__Header_Col_Index_l f $C_Column; 

$Clinical_Data_Col_Header f /Text_l = $Conf ig{Header_Col_l} ; 

#Only now will we add it. 

print "D: Found the Column [1] in the header we are looking 
for!: Index is: » $Wanted__Header_Col_Index_l ' \n" ; 

next; #There is (we/assume) only one unique coloumn name.. 

if ($ Fields [$C_Column] ep/$Conf ig{Header_Col_2 } ) #Scan across the 
header line for column we want #2 

{ #Whoppie/f Found the one we want! 

$Wanted_Header^:ol_Index_2 = $C_Column; 

$Clinical_Dat^a_Col_Header_Text_2 = $Conf ig{Header_Col_2 } ; 

#Only now will we add it. 

print "D: E6und the Coloumn [2] in the header we are looking 
for! : Index is : < $Wanted_Header_Col_Index_2 » \n" ; 

$Clinical^Data_Col_Headerjrext__2 =- s/,/\./g; #Some times 

being Dutch is cute, othertimes its i^ust plain annoying. . .Ja? 

next; /#There is (we assume) only one unique coloumn nanu 

if ($Fields t£c_Column] eq $Conf ig{Header_Col_3 } ) #Scan across the 
header line for column we want #1' 

{ / #Whoppie ! Found the one we want ! 
$wanted_Header_Col_Index_3 = $C_Column; 

;Clinical_Data_Col_Header_Text_3 = $Conf ig{Header_Col_3 } ; 
#Only now will we add' it . 

print "D : Found the Coloumn (3] in the header we are looking 
for! : Index is : 1 $Wanted_H^ader_Col_lndex_3 1 \n" ; 

next; #There is (we assume) only one unique coloumn name... 

($ Fields t$C_Column] eq $Conf ig{Header_Col_4 } ) #Scan across the 
header line for column/ we want #1 

{ #Whoppie! Found the one we want! 

$Wanted_Header_Col_Index_4 = $C_Column; 

$Clinical_Data_Col_Header_Text_4 = $Conf ig{Header_Col_4 } ; 
#Only now wi.ll we add it . 

print "D: Found the Coloumn [4] in the header we are looking 
for!: Index is: /$Wanted_Header_Col_Index_4 • \n" ; 

next; #There is (we assume) only one unique coloumn name... 

} 

if ($Fields [$C_Column] eq $Conf ig{Header_Col__5} ) #Scan across the 
header line £br column we want #1 

{ #Whoppie! Found the one we want! 

$Wanted_Header_Col_Index w _5 = $C_Coluran f - 

$Clinical__Data_Col_Header_JText_5 = $Conf ig{Header_Col_5 } ; 
#9nly now will we add it . 

print "D: Found the Coloumn [5] in the header we are looking 
f or ! : D^dex is : 1 $Wanted_Header_Col_Index__5 ' \n" ; 

next; #There is (we assume) only one unique coloumn name... 

} 

if ($Fields [$C_Column] eq $Conf ig{Header_Col_6} ) #Scan across the 
header line for column we want #1 

{ #Whoppie ! Found the one we want ! 

$Wanted_Header_Col_Index_6 = $C_Column; 
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$Clinical_Data_Col_Header_jrext_6 = $Conf ig{Header_Col_6} ; 
#Only now will we add it . 

print "D: Pound the Coloumn [6] in the header we are looking 
for ! : Index is : 1 $Wanted_Header__Col_Index_6 1 \n" ; 

next? #There is (we assume) only one unique coloumn name... 

if ($Fields [$C_Column] eq $Conf ig{Header_Col_7 } ) #Scan across the 
header line for column we want #7 

{ #Whoppie! Found the one we want! 

$Wanted_Header_Col_Index_7 = $C_Column; 

$Clinical_Data_Col_HeaderjText_7 = SjConf ig{Header_Col_7 } ; 
#Only now will we add it. 

print "D: Found the Coloumn [7] the header we are looking 
f or ! : Index is : 1 $Wanted_Header__Col_Index_7 1 \n M ; 

next; #There is (we assume) oj£Ly one unique coloumn name.. 

} 

if ($Fields [$C_Column] eq $Conf ig { He£der_Col_8 } ) #Scan across the 
header line for column we want #7 

{ #Whoppie! Found thfe one we want! 

$Wanted_Header_Col_Index A = $C_Column; 

$Clinical_Data_Col_Heade?JText_8 - $Conf ig { Header_Col_8 } ; 
#Only now will we add it. 

print "D: Found the Coloumn [8] in the header we are looking 
for I : Index is : 1 $Wanted_Header_Col_Index_8 1 \n" ; 

next; #There is (we assume) only one unique coloumn name.. 

} 

if ($Fields [$C_Column] ejjf $Conf ig{Header_Col_9} ) #Scan across the 
header line for column we want #7 

{ #whoppie y l Found the one we want! 

$Wanted_Header/col_Index_9 = $C_Column; 

$Clinical_Dat^_Col_Header_Text_9 = $Conf ig {Header_Col_9 } ; 
#Only now will we add it . 

print "D: F^und the Coloumn [9] in the header we are looking 
for ! : Index is : « $Wanted_Header_Col_Index_9 ' \n" ; 

next; #Tjiere is (we assume) only one unique coloumn name... 



} 

if ($Clinical_JData _jCol_Header_Text_l eq #I.e., nothing was set 

{die "OppsAnI was looking for the column header: 
' " , $Conf ig{Header_Col_l} , " ' in t^e clinical data file: ' » , $Conf ig{Clinical_Data_File} , " • \nl 
didn't find it!\nWhat I did find was: 1 " , join (";", ©Fields) ' if that helps ... \n" ; } 

if ($Clinical_Da4:a_Col_Header_Text_2 eq " " ) #I.e., nothing was set... 
{die "Op4>s.\nl was looking for the column header: 
• » , $Conf ig{Header_Col_2} , ■ 1 in the clinical data file: '" , $Conf ig{Clinical_Data_File } , " 1 \nl 
didn't find it!\nWhat I did itind was: » » , join ( " ; " , ©Fields) , " ■ if that helps ... \n" ; } 

if ($Clinica/_Data_Col_Header_Text_3 eq "") #I.e., nothing was set... 
{die/"Opps . \nl was looking for the column header: 
« " r $Conf ig{Header_Col_3 } , /■ in the clinical data f ile : • " , $Conf ig{clinical_Data_File} , » ' \nl 
didn't find it!\nWhat I did find was: '",join ( " ; " , ©Fields) , » 1 if that helps ... \n" ; } 

if ($Clin^cal_Data_Col_Header_Text_5 eq " " ) #I.e., nothing was set... 
Lie "Opps.\nI was looking for the column header: 
' » , $Conf ig{Header_Col _j0 , " * in the clinical data file: • " , $Conf ig{clinical_Data_File} , " • \nl 
didn't find it ! \nWhat A did find was: 1 » , join ( " ; » , ©Fields) , " • if that helps ... \n» ; } 

if ($plinical_Data_Col_Header_JText_7 eq "") #I.e., nothing was set... 
{die "Opps.\nI was looking for the column header: 
1 " , $Conf ig{Header_abl_7} , " • in the clinical data file: 1 ■ , $Conf ig{Clinical_Data_File} , " 1 \nl 
didn't find it!\nWhat I did find was: 1 « , join ("; " .©Fields) , » • if that helps ... \n" ; } 

iff ($Clinical__Data_Col_Header_Text_8 eq "") #l.e., nothing was set... 
{die "Opps.\nI was looking for the column- header : 
• » , $Conf ig{Head£r_Col_8 } , " 1 in the clinical data file: » " , $Conf ig{Clinical_Data_File} , » • \nl 
didn't find it/\nWhat I did find was: ■« , join (";•', ©Fields) , " 1 if that helps ... \n" ; } 

if ($ClinicalJData_Col_Header_Text_9 eq ) #I.e., nothing was set... 
{die n Opps.\nI was looking for the column header: 
'» , $Conf ig{ifeader_Col_9} , " ' in the clinical data file: • " , $Conf ig{clinical_Data_File} , ,M \nI 
didn't find it!\nWhat I did find was: ' " , join ( ■ ; « , ©Fields) , » ' if that helps ... \n" ; } 
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to next line 



next ; 
} 



#We have found the Coloumn that we are looking for ... so skip 



# print "D: Loading Clinical Classification for Patient : 1 $Fields[0]' this 

is : 1 $Fields [$Wanted_Header_Col_Index_l] » & : ' $Fields [$Wanted. Header_Col_Index_2] • 

' $Fields [$Wanted_Header_Col_Index_3] 1 &: ' $Fields [$Wanted_He ^der_Col_Index_4] 1 &: 



1 $Fields [$Wanted_Header_Col_Index_5] ' \n" ; 
Patient ID 



#The first field contains theyheader 



# 
# 
# 



i ii 



if (exists $Classif ication{ $Fields [$Wanted_Header_Co3__Index] } ) 
{#We already have one of these! 

die "Error! Patient IDs are not unique 1 \nThi s one 
, $classif ication { $Fields [$Wanted Header Col Index] } » M 1 foioid for the 2n6/timer' 

} 



$Classif ication_l{$Fields [0] 
$Classification_2{$Fields [0] 
$Classif icationJ3 {$Fields [0] 
$Classif ication_4 {$Fields [0] 
$Classif ication_5{$Fields [0] 
$Classif ication__6 { $Fields [0] 
$Classif ication_7 {$Fields [0] 
$Classification_8{$Fields [0] 



$ Fie Ids [ $Wanted_Headsr_Col_lndex/l 3 
$Fields [$wanted_Head<=sr_Col_lncte!x_2 ] 
$Fields [ $Wanted_Heade3r_Col_Inidex_3 ] 
$Fields [ $Want ed_Header_Col Iftdex_4 J 
$Fields [$Wanted_Heade=r__Col J /lndex_S) 



$ Fields [$Wanted_Heade=ir_ 
$Fields [$Wanted_Keader 
$Fields [$Wanted_HeadeB: 
$Fields [$Wanted 



Heade=saf Col 



Index 
Index 
_Index_ 
Index 



6] 
7] 
8] 
9] 



want : 



$Classification_9{$Fields [0] _ 

push ©Classification, $Fi elds [$ Want ed__Header_Col_Ind< 
so just add this one 

} , 
########################Prepare colors################tt#|##* ## 

#$Image -> f illedRectangle ($xl, $yl , $x2+20*$CatergoryV$Con_:f ig{Block_Size } 

$Block_color) ; / 

#This last expression is so that all the bars will fi/ on! The 800 is a guess! 

my $Width = $Conf ig{Block_Size } * $Row + ( $Config{ Blpck_Sizei } + $Conf ig{Graph_Space} 

my $Height = $Conf ig{Block_Size} * $Max_Col; 

^Create Image canvases & Allocate basic colors to 



#We know which column we 



$y2, 



8) 



.hem 



2J55) 



tf=Create main image 'Canvas' 
#Set first color (also background 



^Allocate color 
#=Allocate color 
#Allocat«a color 'Black' 



' Blue 
'Red' 



my $ Image = new GD : : Image ($Width , $Height) ; 
my $white = $Image -=» colorAllocate (255,255, 
color ! ) 

Top_Color__Print () ; 

#my $Blue = $Image -> colorAllocate (0,0,2 
#my $Red = $Image -> colorAllocate (255, 0,q 
my $Black= $Image -> colorAllocate (0,0,0 
Top_Color_Print ( ) ; 

my $Col_Stripe_Width = $Conf ig{Block_Siz4} * $Conf ig{Scale } 
my $Col_Stripe_Height = $Conf ig{Block_s/ze} * $Config{ Scale} 

print "D: Color Stripe will be ($Col_Stripe_Width x $Col_Strripe_Height ) \n» ,- 
my $Color_Stripe_IMG = new GD: : Image /($ Co 1_S trip e_Width, $Co l_Stripe_Height ) ; 
$Color_Stripe_lMG -> colorAllocate (>255, 0 , 255) ; #Set firast color (also background 

color! ) 



($Conf ig{Color_S trips }+l) ; 



my $Title_Bar = new GD: : Image ($Width , 100) ; 

$Title_Bar -> colorAllocate (255,255,255); #Set first coloirr (also background color!) 
#my $Blue = $Image -> colorAllocate (0,0,255); tf=Allocate color 'Blue',- 

#my $Red = $Image -> colorAllocate (255,0,0); #=Allocate color 'Red'; 

$Title_Bar -> colorAllocate AO ,0,0); #Allocate color 'Black'; 

my $Patient_IDs = new GD::/mage (400, $Height) ; 

$Patient_IDs -> colorAllocate (255 , 255, 255) ; #Set first colo^cr (also background color!) 
#my $Blue = $Image -> colorAllocate (0,0,255); #=Allocate color 'Blue'; 

#my $Red = $Image -> coltor Allocate (255,0,0); #=Allocate color 'Red'; 

$Patient_IDs -> colorAllocate (0,0,0); #Allocat« color 'Black'; 

#my $Image = new GD: :/mage (1000,100); #HW: For. testing Color Stripe... 

my @Color_S tripe; 

#Colors run: Full Bl/ue - Partial Blues - Full White - Partia_l Reds - Full Red 
print "D: Allocate / Blues ' : \n»; 

foreach my $C_Col£Jr (0 . . ($Conf ig{Color_Strips} /2-1) ) frRun: Full Blue to one level 

below white 

{ 

printf ( n %3i " , $C_Color) ; 
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my $Blue_level = 2 55/ ($Conf ig{Color_Strips}/2) *$C_Color ; #The (complex) 
calculation for the color level 

print "D: Allocating Color: Blue_level = 1 $Blue_level ' \n" ; #works for the 

red as well but without the "255-" part 

push ©Col or_S tripe, $Image -> colorAllocate ($Blue__level , $Blue_level , 255) ; 

# $Color_Stripe_IMG -> colorAllocate (255 , $Blue_level, $Blue_level) ; 

Top_Color_Print () ; 
} 

#print "D: $#Color_Stripe , ©Color_Stripe\n" ; #Note down 

the index of the color just allocated in a 'look-up' table 
#print "D: Allocating White: < As mid point >" ; 

push @Color_Stripe, $Image -> colorAllocate (255,255,255); #The 'White' is fixed. 
#$Color_Stripe__IMG -> colorAllocate (255,255,255); 
#Top_Color_Print () ; 

#print "D: $# Co lor_S tripe , @Color_Stripe\n" ; 
print "\nD: Allocate 'Reds': \n" ; 

foreach my $C_Color (1 . . ($Conf ig{Color_Strips}/2) ) #Run: /one above 'white' to full red 
{ 

printf ("%3i " , $C__Color) ; 

my $Red_level = 255 - 255/ ($Conf ig{Color_S trips )//2 ) *$C_Col or ; 
print "D: Red_level = ' $Red_level ' \n" ; 

push ®Color_Stripe, $Image -> colorAllocate {2& 5 , $Red_level , $Red_level ) ; 

# $Color_Stripe_IMG -> colorAllocate (255 , $Red_^vel , $Red_level) ,- 

# Top_Color_Print ( ) ; 

) 

print "\n"; 

#print "D: $#Color_Stripe , @Color_Stripe\n" ; 
print "D: Strip Colors = '@Color_Stripe ' \n" ; 

#####M#################Build array image#######J r *########### 
#Build array 

my $Range=sqrt ( ($Config{ Maximum} - $Config {Minimum} ) ** 2) ,- #Ok, so we know that for 

Pearson CC it will be 2 
my $BINS = $#Color_Stripe +1; 
my $Bin_width= $Range / $BINS; 

print "D : Possible BINS = 1 $BINS 1 ; For Ran^e « ' $ Range • , so each bin is: '$Bin_width' 
wide\n" ; 

print "D: Building Array: \n"; 
print "D: " ; 

foreach my $row (0 . . $#Matrix) / #Cycle through all rows 

{ 

foreach my $col (0 . . $Max_Col) / #Cycle through all coloumsn 

{ ~ , ; 

if ($row == $col) {last;} 

my ($xl, $x2, $yl, $y2, $colar) ; ^Declare Intermediate variables 

ray $value = $Matrix [$ro^] [$col] - $Conf ig{Minimum} ; #Re-center the 

data scale to +ve 

# print "D: value = '$vaJiie' " 
^Calculate the color required using the same indices as lodged ©Col or_S tripe (NB: 
Color_Stripe need not exist by this stage: OPTIMISES AWAY?) 

$color = int ($value / $Bin__width) +1 +1; #The extra ' +1 1 is becaa 

# print "\nD: Matrix Color = $color, \n" ; 

# $bin = int ($value L) * (1/ $Color_S trips +1) ; 

# print "D: Bin = ' $tfolor »\n" ; 

if ( $color >= $Bigfe) {$color = $bins ; } 

$xl = $Conf ig{Block_Size} * $col; $x2 = $xl + $Conf ig{Block_Size} -1 ; 
#Top left to Bottom righy of a square 

$yl = $Config{Blo£k_Size} * $row; $y2 = $yl + $Conf ig{Block_Size} -1 ; 

# die "HIT BLOCK" 

# print "D: xl - Ski, x2 = $x2 ; yl = $yl ; y2 = $y2\n»; 

if ($Patient_IDy($row} eq $Conf ig{Marked_Patient } ) # print "D: value = 

'$ value ' \n" ; 

{$coloi/=$ Black; } 

$Image -> f ilaedRectangle ($xl, $yl, $x2 , $y2, $color) ; #Actually draw 

the square at the correct location 

# $Image -> rectangle ($xl, $yl, $x2-l, $y2-l, $Black) ; ^Outline the square 

} ; 

printf ("%5i n ,$row); (y ttJust a counter printed to the screen / stream 

# die "HIT BDOCK\n" ; 

} 
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print tt \n"; 

if <$Config{Block_Lines} eq »T") #Did the user request lines? 

{ 

Draw_Iiines_on_Image () ; 

} 

my $Classes; my $Class_Lowest__Color ; 

if ($Config{Mark_Patient_Data} eq "Y" ) 
{ 

($Class_liOwest_Color, $Classes) = Mark_Pato.ent_Data {) ; 

) 

print "D: Classes Returned = ^Classes'; number of colors needed: 
' » , $Class_Lowest_Color, " • \n" ; 

#my $Classification_Stripe_IMG = new GD: : Image ($Conf ig{Block_Size} * $Classes * 
$Config{ Scale } , $Conf ig{Block_Size} * $Conf ig{ Scale}) ; 

Invoke Draw_Key (> if necessary 

if ($Config (Draw_Color_S tripe} eq "T") 

{ 

Draw_Color__S tripe () ; 

} 



# Combine the images and write them out: 

my $ Parent_Image = new GD : : Image ($ Width + 100, $Height + 200/9 ; #Create final 

image 1 Canvas 1 into which others are merged 

my $White = $ Par ent_Image -> colorAllocate (255,255,25/); #Set first color (also 

background color ! ) 

my $Black - $Parent_Image -> colorAllocate (0,0,0),- / #Formally allocate color 

'Black' 

my $Patient_ID_Width = 250; 

$Parent_Image -> copy ($Image, $Patient_ID_Width, 100 , 0/, 0, $Width, $Height) ; #Merge the 

main heat -map / Patient Data. 

$Parent_Image -> copy ( $Patient_IDs , 0,100, 0,0, $Patytent_ID_Width, $Height) ; #Merge the 
Patient IDs 

$Parent_Image -> copy ($Color_Stripe_IMG, ($width - $fcol_Stripe_Width) /2 + 
$Patient_ID_Width, $Height + 100 + 100 - $Col_Stri$fe_Height , 0, 0, $Col_Stripe_Width, 
$Col_Stripe_Height+l) ; 

$Parent_Image -> stringTTF ($Black, ». /fonts/aria/ . ttf " , 30, 0, 

($Width - $Col_Stripe__Widt*i) /2 + $Patient_ID_Width - 40 
$Height + 100 + 40 + ($Co/f ig{Block_Size} * $Config {Scale } ) /2, 
"-1"); 

$Parent_Image -> stringTTF ($Black, » . /f onts/irial . ttf » , 30, 0, 

$Width / 2 + 100 - 10,/ 

$Height + 100 + 40 + raConf ig{Block_Size} * $Config {Scale } ) /2, 
" 0 •' ) ; 

$Parent_Image -> stringTTF ($Black, " . /f onts/arial . ttf " , 30, 0, 

($Width - $Col__Stri£e_Width) /2 + $Patient_ID_Width + 

$Col_Stripe_Width , 

$Height + 100 + 40/+ ($Conf ig{Block_Size} * $Conf ig{Scale } ) /2, 
»+l»); 

my $xl=0; 

$Title_Bar -> stringTTF ($Black, » . /f oj*ts/arial . ttf » , 30, 0, 

$xl, 90, "FAB") 
$xl - $xl +$Conf ig { Graph_Space } ; 

$Title_Bar -> stringTTF ($Black, ». /fonts/arial . ttf " , 30, o, 

$xl, 90, "WBC/) ; 

$xl = $xl +$Conf ig{Graph_Space} ; 

$Title_Bar -> stringTTF ($Black, »| /fonts/arial . ttf ■ , 30, 0, 

.SKisEi; $xl, 90, m f4t3 ITD" ) ; 

$xl = $xl +$Conf ig{Graph_Space} ; 

$Title_Bar -> stringTTF <$Black t «. /fonts/arial . ttf " , 30, o, 

$xl, 90, "OS"); 

$xl = $xl +$Conf ig{Graph_Space} ; 

$Title_Bar -> stringTTF ($Black, ». /fonts/arial . ttf M , 30, o, 
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$xl # 90, "EFS") ; 
$xl = $xl +$Conf ig{Graph_Space} ,- 

$Title_Bar -> stringTTF ($Black, « . /f onts/arial . ttf " , 30, 0, 

$xl, 90, "EVI1") ; 

$xl = $xl + $Conf ig{Graph__Space} ; 

$TitleJBar -> stringTTF ($Black, /f onts/arial .ttf " , 30, 0, 

$xl, 90, "CEBP mutant") ; 

$Parent_Image -> copy ($Title_Bar, $Patient_ID_Width, 0, 

0, 0, $Width, 100) ; 

print "Just to remind you: the image created will be : 1 " , $Conf ig{Output_File} , n ' (you can 
alter the default by using 2nd command line argument) \n" ; 

$Parent_Image -> stringTTF <$Black, " ./f onts/arial .t£f" , 50, 3.142 / 2, 

$Width - 100, 
$Height , 

"Orginal Correlation File :/* $Conf ig{Correlation_File} • M ) ; 
$Parent_Image -> stringTTF <$Black, " . /fonts /ar^al . ttf " , 50, 3.142 / 2, 

$Width - 40, 
$Height , 

"This Image is: 1 $Conj&g{Output_File} 1 ") ; 

binmode OUTPUT ; 

open OUTPUT, ">$Conf ig{Output_File) " or^lie "Cannot open output file: '" , 
$Conf ig{Output_File} , " ' \n" ; 

print OUTPUT $Parent_Image -=» png <);/ #Thankfully OOl The difficult bit I 

close OUTPUT; y&Will close anyway upon program exit 



# 

#Subroutines only below here ./ 
# 

# ####################£###### 
#########SUB START 
sub Draw_Lines__on_Image { 

print "D: Ok, You/wanted lines. . . .\n"; #Guess so 

my $x__max = $Con£ig{Block_Size} * $Max_Col; #Pre- calculate the right-hand edge 
my $yjmax = $Conf ig{Block__Size} * $Row; #Pre- calculate the bottom edge 

print "D: (Horizontal): "; 

foreach my $row (0..$Row) #For all rows 

{ / 

m y $Y h $Conf ig{Block_Size} * $row; #Calculate the 'y» position 
$Image -> line (0, $y, $x_max, $y, $Black) ; #Draw Horizontal Line 

# print* ("%5i " , $row) ; 

} 

print "\n" ; 

print "D: ^Vertical) : "; 
.foreach my/ $ col ( 0 . . $Max__Col ) #For all coloumns 

{ 

m 




$x = $Conf ig{Block_Size} * $col; #Calculate the 'x» position 
:mage -> line ($x, 0, $x, $y__max, $Black) ; #Draw Vertical Line 
# pVintf ("%5i ",$col); 



print "\n n 
} 



####fl####SUB START 

sub Draw_Color_S tripe { 
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my $White = $Color_Stripe__IMG -> colorAllocate (255,0,255),* #Set first color (also 

background color ! ) 

my $Black = $Color_Stripe_IMG -> colorAllocate (0,0,0); ^Allocate color 'Black' ; 

print »D: Color Stripe image is: 1 $Col_Stripe_Width x $Col_Stripe_Heigrit 1 \n" ; 
$Color_Stripe_IMG -> rectangle (1,1, $Col_Stripe_Width -1, $Col_Stripe_Height-l , $Black) ; 
#my $lmage = new GD: -Image (1000,100); #HW: For testing Color stripe... 

#my @Color_S tripe ; 

#Colors run: Full Blue - Partial Blues - Full White - Partial Reds - Full Red 
#print "D: Allocate 'Blues 1 : \n" ; 

my @Color__Stripe_Bar ; 

#Colors run: Full Blue - Partial Blues - Full White - Partial Reds - Full Red 
print "D: Allocate 'Blues': \n" ; 

f oreach my $C_Color (0 . . ($Conf ig{Color_Strips}/2-l) ) #Run: Full Blue to one level 

below white 
{ 

printf <"%3i " , $C_Color) ; 

my $Blue_level « 255/ ($Config{ Color_St rips} /2/*$C_Color ; #The (complex) 
calculation for the color level 

# print "D: Allocating Color: Blue_level = » $^lue_level 1 \n M ; #works for the 
red as well but without the "255-" part 

push @Color_Stripe_Bar, $Color_Stripe_IMG/- > colorAllocate 
( $Blue_level , $Blue_level ,255); 
} 

print "D: Color_Stripe_Bar : , |@Color_Stripe_B^fr" | i.e. has: $#Color_Stripe_Bar +1 
divisions\n" ; 

#print "D: $#Color_Stripe , @Color_Stripe\n» ;/ #Note down 

the index of the color just allocated in a /look-up' table 
#print "D: Allocating White: < As mid poin£ >"; 

push @Color_Stripe_Bar, $Color_Stripe_IMG/- > colorAllocate (255,255,255); #The 'White' is 
fixed. 

print "D: Color_Stripe_Bar : , | ®Color_St^ipe_Bar | i.e. has: $#Color_Stripe_Bar +1 
divisions\n" ; 

sprint "D: $#Color_Stripe , @Color_Stri$*e\n" ; 
print "\nD: Allocate 'Reds': \n" ; 

f oreach my $C_Color (1 . . ($Conf ig{Colo/_Strips} /2) ) #Run: one above 'wriite' to full red 
{ 

printf (»%3i " , $C_Color) ; 

my $Red_level = 255 - 255/ ($Config{ Color_St rips} /2) *$C_Color; 

# print "D: Red_level = • $Red/level » \n" ; 
push @Color_Stripe_Bar , $Co*Lor_Stripe_IMG -> colorAllocate 

(255, $Red_level, $Red_level) ,- 

} 

print "\n"; 

print "D: Color_Stripe_Bar : , | @<jfolor_Stripe_Bar | i.e. has: $#Color_Stripe_Bar +1 
divisions\n" ; 

print "D: Will use color: w ; 
f oreach my $C_color ( 0 . . $#Color_Stripe_Bar) 

{ 

printf ( "%3i " , $C_crflor) ; 

# print "D: Drawing box: • $C_color » \n" ; 

my $X1 = ($C_color/ * $Conf ig{Block_Size} * $Config{ Scale } ; ^Account for off- 

center scale: 3,4,5.. toy6,l,2 for plotting 

my $X2 m ($C_colofr +1) * $Conf ig{Block__Size } * $Config {Scale } ; 

# print "D: XI - 'SX1', X2 = » $X2 » , "; 

#print "D : Will use col/5r = 1 $Color_Stripe [$C_color] ' , i.e. A_color: $A_color; C_color: 
$C_color; 

printf (»%2i " /$C_color) ; 

$Color_Stripe_a:MG -> f illedRectangle ($X1, 0, $X2, $Conf ig{Block_Size} * 
$Conf ig{ Scale} , $Coloj7_Stripe_Bar {$C_color) ) ; 

$Color_St ripe/ IMG -> rectangle ($X1, 0 , $X2-l, $Conf ig{Block^Size} * 
$Config {Scale } -1, $B^ck) ; 

# $Color_Strigfe_IMG -> stringTTF ($Black, " . /f onts/arial . ttf n , 20, 0,$X1, 20, 
$C color) ; 

} 
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#Highlight the middle part of the scale : 
my $C_color = $#Color_Stripe/2 ; 
my $X1 = $C_color * $Conf ig{Block_Size} ; 
for plotting 

my $X2 = ($C_color +1) * $Conf ig{Block_Size} ; 



#Account for off-center scale: 3,4,5.. to 0,1,2 



#$Color_Stripe_IMG -> rectangle ($X1 * $Config {scale }, 1, $X2 * 
$Config{ Scale} , $Config{Block_Sizej * $Conf ig(Scale) -2 , $Black) ; 

#open OUTPUT, ■ >Color_S tripe .png" or die "Cannot open output file: 1 Color_S tripe .png ' \n" ; 



#print OUTPUT $Color_Stripe__IMG -> png () ; 
#close OUTPUT; #Will close 

} 



#Thankfully OO! The difficult bit! 
lyway . . . 



The difficult 



#########SUB START 
#sub Draw__Classif i cat ion_S tripe { 
#HBY! This doesn't do anything ill! 

#open OUTPUT, ">Classif i cat ion_S tripe .png" y6r die "Cannot open output file: 
' Classif ication_S tripe .png 1 \n" ; 

#print OUTPUT $Classif ication_Stripe_IMG /- > png () ; ^Thankfully OO! 

bit! 

#close OUTPUT; #Vtyill close anyway. 

#} 

#########SUB START 
sub Load_Conf iguration { 

#This loads configuration into the/main Config hash array. Defaults are gi"ven first 
$Conf ig{Block_Size} / = 16; #The size (in Pixels) of each block. 

#File names : Hard Wired in versio4i 1_1 ! 



$Conf ig{ Clinical_Data File } 
23_07J003.csv"; #The name 

$Conf ig {Output_File } 
final generated image. 
#Other parameters : 
$ Config {Block_Lines} 
the blocks 

dimensions 

$ Config {Draw_Color_St3&ipe} 
$Config {Color_S trips' 
1 Strip 1 

$Config {Minimum} 
$Config {Maximum} 
$Config {Scale} 
to $Block_Size of 
$Conf i g { Cor re 1 at 

View all clustered 
$ Conf i g { Co rr e 1 at i on_F i 1 e } 
$Conf ig{ Header /col_l) 
$Conf ig{Header_Col_2 } 
$ Conf i g { Header_Co 1_3 } 
# $Conf ig { Heade r_Col_4 } 
$Conf ig{Header_Col_5 } 
$ Conf ig { Hejader_Co 1__6 } 
$Conf ig {Hyader_Col__7 } 
$Conf ig{Header__Col_8} 
$Conf ig GHeader_Col_9 } 



$ Conf i g { Mark_Nul Is} 



he Blocks in 
n_File} 

columnsets 



- " . /csv/Tabel AML clinical and molecular data 
of the Clinical Datafile {Comma delimited format) . 

= "48SOutput .png" ; tfltfame of the 



= »F"; #Whether to draw lines round trie (inside) of 

#NB: Reduces colored area by 1 pixel in both 

= "T"; #Should a Key be prepared? 
= 40; #The number of intervening colors in the 

= -1; ^Assumed minmum of correlation data 
= +1; #Assumed minmum of correlation data 

= 5; #The multiplication factor for relative 

the Color Stripe 
= " ./362 

. CSV" ; 

- " . / incoming/ 48Sgenes . csv" ; 
= "FAB"; 

« "WBC" ; 

- "FLT3 ITD" ; 
= "FLT3 TKD"; 
= "OS"; 

= "efs"; 

= "EVIl"; 

» "CEBP mutant"; 

= "Osi" ; 



= "SPOT"; 



nyn . 



$Conf ig { Mark_Pat i ent^Data } 
$Config{Marked_Patient} = "XXXXXXXXXXXXXXXXX" ; # Inserts a black 

line to demonstrated correspondence / registery between patient CC and classification type 
$Conf ig{Label_Cl asses} = "Y"; 
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$Config{Second_Scale_Spacing} = $Conf ig{Block_Size} * 10; #The spacing between the 

first and the second scale... *10 sets this to -130% the length of the first scale 

set by MJM because they were "nice 



no scientific 



# 



$Conf ig{Low_Blood_Count } 
round numbers" they have 
$Conf ig{Med_Blood_Count} 
$Conf ig{Hi_Blood_Count) 
$Conf ig{Blood_Count_ Max} 
$Conf ig { EFS_Max } 
$ Conf i g { OS_Max } 
$Conf ig{Graph_Space} 
$Conf ig{Font_Size} 
#print "D: Reading Configuration Information from STDUST:\n"; 
#my $Keys_Read=0; 



100; #The3e were 
justification 
150; # 

= 200 
300; # 
166; 
166; 
250; 
15; 



#my @STDIN= <STDIN>; 
#if <$STDIN[0] eq wu ) 
ttforeach (OSTDIN) 

# ( 

# chomp () ; 

# unless (/=/) 

is :\n« Parameter = Value 1 \nWhat was found was: ' / '\n" ;} 



{return; } 



{die "Error reading cofigu/ation file: Pattern expected 



# 
# 
# 
# 
# 

#print 
} 



s/ //g; #Kill all 

(my $Key , my $ Value) = 
print "D: Key = ' $Key' ; 
$Keys_Read ++; 

} 

"D: Finished reading config file 



spaces 

split ("/",$_) 
Value = ' $va/ue 1 \n" 



total ' $Keys_Read» extra parameters read\n' 



#########SUB START 
sub Mark_Patient_Data { 
#Find number of Colors needed 



(i.e. 



my 
my 
my 



#M5 




nd number of catergories 
$Black a $image -> colorAllocate /0,0,0); 
$Yellow = $image -> colorAllocatfl£ (255,255,0); 
$Cyan = $lmage -> colorAllocate /(0 , 255 , 255) ; 
$Maroon = $Image -> colorAllocafte (176,48,96); 
$Orange = $Image -> colorAllocate (255,165,0); 
$Pink = $Image -> colorAllocate (255,105,180); 
$D_Green = $ Image -> color Allocate (85,107,47) 
$Green = $Image -> colorAllocate (0,255,0); 
$Red = $Image -> colorAllocate (255,0,0); 



#M6 

#M4 
#M3 
#M2 
#M1 



#M0 



$Sof t_Green 
$Soft_Red = 
$Low =$ Image 
$Med =$ Image 
$Hi =$Image 



- > 



- > 

- > 



$Image /> colorAllocate (128,255, 128); 
$Image/-> colorAllocate (255,128, 128); 
colorAllo<rate (32,32,32); #12.5% Grey: Low Blood Cell count 
colorAllocate (128,128,128)? #50% Grey: Medium Blood Cell count 

colorAllocate (214,214,214); #87.5% Grey: High Blood Cell count 

#Cycle through all rows 



foreach my $row (0 . . $#Matyix) 
{ 

my ($xl, $yl, $x2A $y2) ; #$row; my $Y = $row; 

$xl = $Conf ig{B16ck_Size} * $row; $x2 = $xl + $Conf ig{Block_Size} ; #Top left to 
Bottom right of a squari 

$yl = $xl; $y2 k $yl + $Conf ig{Block_Size} -1 ; 

#This is the diagonals of the square. ... 
my $x_cent = int ( ($x2 - $xl ) /2) + $xl; my $y_cent = int ( ($y2 - $yl ) /2) + 
#The center might be useful ... calculation is over complex, but hey - it's standardl 
my $C_Class J $Classif ication_l { $Patient_ID{$row} } ; #Just a convenience 



$yi; 

really. 



print "D: Classification of Patient ($Patient_ID{ $row} ) #'$row' = • $C_Class ' \n tt ; 
$Image -> f/lledRec tangle ($xl, $yl, $x2, $y2 , $White) ; #Blank blocks on 

diagongal 

#print "D: $#Color'_Stripe , @Color_Stripe\n" ; #Note down 

the index of the Color just allocated in a 'look-up 1 table 
#print "D: Allocating White: < As mid point >" ; 



#Ok! This is where the logic begins... 
#Do classification #1: FAB Type: 
if ($C_qiass =~ m/Mx/) 

#Ie. A mixed system. . . 
#Draw Spot .... 

print "D: Mixed classification found - drawing spot\n" ; 
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# $Image -> line <$xl, $yl, $x2 , $y2, $Black) ; 

$Image -> arc ($x_cent , $y_cent , $Conf ig{Block_Size } , $Conf ig{Block_Size } , 0 

,3 60 , $Black) ; 

$Image -> fill ( $x_cent , $y_cent , $Black) ; 

print "D: Diagonal block runs: $xl, $yl through center at $x_cent, $y_cent 
to: $x2, $y2\n" ; 

} 

if ($C_Class eq "») 

{ #Ie. Missing Classification... 

print "D: Missing Classification: Drawing a cross\n" ; 
$Image -> line ($xl, $yl, $x2, $y2, $Black) ; 
$lmage -> line <$x2, $yl, $xl f $y2, $Black) ,- 
next ; #Easy eh? ( ; - ) 

} 

if ($C_Class =~ ra/M/ and not $C_Class =~ m/Mx/) 
{ 

my $Block_color; 

my $Catergory = substr ($C__Class, lyi) ; 
print "D: Catergory = * $Catergory ; 



if 


($Catergory 




6) 


{ $Block_coaor 




$ Yellow; } 


if 


($Catergory 




5) 


{ $Block_aolor 




$Cyan ; } 


if 


($Catergory 




4) 


{ $Block /color 




$Maroon ; } 


if 


($ Catergory 




3) 


{ $Bloch£color 




$0range ; } 


if 


($Catergory 




2) 


{ $BlooK_color 


8 


$Pink;} 


if 


($ Catergory 




1) 


{ $Block_color 




$D_Green; } 


if 


($Catergory 




0) 


{ $Block_color 


=: 


$Green; } 



print "D: Will use color : / 1 $Block_color ' \n" ; 
$x2 = $xl + 20*$Catergory+$Conf ig{Block_Size} -1; 
$Image -> filledRec tangle ($xl, $yl, $x2 , $y2, $Block_color) ; 
if ($Config{liabel_Cl asses} eq " Y " ) 

{ 

$lmage -> str/ngTTF ($Black, " . /fonts /Courier . ttf" , 15, 0, $x2+10, 

$y2, $Catergory) ; 

} } 

$Patient_IDs -> stringTTF/($Black, " . /fonts/Courier . ttf » , $Conf ig { Font_Si ze } , 0, 1 
$y2, $Patient_ID{ $row} ); 

if ($Patient ID{$row} ea/ $Conf ig{Marked_Patient } ) #This is used to check 

the 'register' between the CC data and the Patient Classification, 

{ 

# my $Block_color = $Black; 

my $Catergory/= substr ($C_Class # 1,1); 

print "D; Marking Patient: ' $Patient_ID{$row} 1 using color: BLACK\n" ; 
my $Catergory = 10; 

$Image -> filledRect angle ($xl, $yl, $x2 + 20 * $Catergory, $y2, $Black) ; 

} 



/ 



#Now something similar for classification #2 (Blood Cell Count) : 

$xl=$xl + $Conf ig{Graph_Space} ; #ie. give some space between the two scales 

$x2 = $xl + $Gonf ig{Block_Size} ; 

my $Blood_Count = $Classif ication_2 { $Patient_ID{$row } } ; 
print "D: Blood count = 1 $Blood_Count ' \n" ; 
if ($Blood_Count == undef) 

{ / 

print "D: Missing Blood Count Classification: Drawing a cross \n" ? 
$ Image -> line ($xl, $yl, $x2, $y2, $Black) ; 
$lmage -> line ($x2, $yl, $xl, $y2, $Black) ; 

) / 

else 

</ 

.y,.$Bar_Length = $Blood_Count / $Conf ig{Bloocl_Count_Max} * 200; 
raw_blood_bar ($Med, $Blood_Count , $xl , $yl, $Bar_Length) ; 

# $Confc£g { Blood_Count_Max) 

#Now somethi/ng similar for classification #3 (FLT ITD) : 

$xlJ$xX^+ $Conf ig{Graph_Space} ; #ie. give some space between the two scales 
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my $FLT_Class = $Classif ication__3 ($Patient_ID{ $row} } ; 

print "D: FLT3 Class = ' $FLT_Class ' for Patient: ' $Patient_ID{ $row} ' \n" ; 
if ($FLT_Class eq » " ) 
{ 

print "D: Missing FTL Classification: Drawing a cross\n" ; 
$x2 = $xl + $Conf ig{Block_Size} ; 
$Image -> line ($xl, $yl, $x2, $y2, $Black) ; 
$ Image -> line <$x2, $yl, $xl, $y2, $Black) ; 

) 

else 

if <$FLT_Class =~ m/Pos/i or $FLT_Class =~ m/Yes/i) 
{ 

$x2=$xl + 150; 

$Image -> f illedRectangle ($xl, $vl, $x2, $y2, $Soft_Red) ; 
$Image -> stringTTF ($Black, " . /^onts /Courier . ttf ■ , 
$Config{Font_Size} , 0, $x2+10, $y2-2, "Pos"),- 

} 

else 

{ 

$x2=$Xl + 75; 

$lmage -> filledRect angle/ ($xl , $yl, $x2, $y2, $Sof t_Green) ; 

$Image -> stringTTF ($Black, " . /fonts/Courier . ttf 11 , 
$Config{Font_Size}, 0, $x2+10, $y2-3, "Neg")/ 

} 

} 



#Now something similar for classif icalfion #5 (OS) : 

$xl=$xl + $Con£ig{Graph_Space/J ; #ie. give some space between the two scales 

$x2 = $xl + $Conf ig{Block_SiLze } ; 
my $OS = $Cla3sif ication_5{/Patient_ID{$row} } ; 
print "D: OS = '$OS'\n«'; 
if ($OS eq »'•) 

{ 

print 11 D : Missinjg OS Classification: Drawing a cross\n" ; 
$Image -> line /$xl, $yl, $x2, $y2, $Black) ; 
$ Image -> line/($x2 / $yl, $xl, $y2, $Black) ; 

} 

else 
{ 

my $Bar_Lendth = $OS / $Conf ig {OS_Max} * 200; 
Draw_blood/bar ($Med, $OS / $xl f $yl, $Bar_Length) ; 

} 

# $Conf ig { Blood_Count_Max } 

#Now something similay for classification #6 (EFS) : 

$xl=$xl + $Conf ig { Gr aph_Space } ; #ie. give some space between the two scales 

$x2 = $xl + y$Conf ig{Block_Size} ; 

my $EFS = $Classif ication_6 { $Patient_ID { $row} } ; 
print »D: $p'atient_ID{ $row} EFS = '$EFS'\n»; 
if ($EFS eg 7 »") 

{ ; 

prAnt "D: Missing EFS Classification: Drawing a cross\n" ; 
$Image -> line ($xl, $yl, $x2, $y2, $Black) ; 
{Image -> line ($x2, $yl, $xl, $y2, $Black) ; 

f else 

ty>:^3«r / p r i nt "D: Testing Dead/ alive status: 

» ", $Classif i</ation_9{$Patient_ID{$row} } , « '\n» ; 

my $Bar_Length = $EFS / $Conf ig{EFS_Max} * 200; 
if <$Classification_9{$Patienfc_ID{$row}} eq "alive") 

{Draw_blood_bar ($Sof t_Green, $EFS,$xl, $yl, $Bar__Length) ; } 
else 

{Draw_blood_bar ($soft_Red, $EFS,$xl, $yl, $Bar_Length) ; } 

} 



Figure 15] 



ii 



WO 2005/080601 ANNOTATED SHEET ! PCT/NL2005/000134 

26/27 



#Now something similar for classification #7 (EVll) : 

$xl=$xl + $Conf ig{Graph_Spa.ce} ; #ie. give some space between the two scales 

my $EVTl_Class = $Classif ication_J7{$Patient_lD{$row} } ; 

print "D: EVll Class = ' $EVIl_Class 1 for Patient: ' $Patient_ID{ $row} » \n" ; 
if ($EVTl_Class eq »") 

{ 

print "D: Missing EVll Classification: Drawing a cross\n"; 

$x2 = $xl + $Conf ig{Block_Size} ; 

$Image -> line ($xl , $yl, $x2, $y2, $Black) ; 

$lmage -> line ($x2, $yl, $xl, $y2, $Black) ; 

} 

else 

{ 

if ($EVIl_Class =_ m/Pos/i or $EVIl_Class =- m/Yes/i) 
{ 

$x2=$xl + 150; 

$lmage -> f illedRectangle ($x^, $yl, $x2, $y2, $Soft_Red) ; 
$Image -> stringTTF ($Black / /" . /fonts/Courier . ttf " , 
$Config{Font_Size} , 0, $x2+10, $y2-2, "Pos"); 

} 

else 

{ 

$x2=$xl + 75; 

$Image -> f illedRectangle ($xl, $yl, $x2, $y2 , $Soft_Green) ; 

$Image -> stringTTF ($Black f 11 . /fonts/Courier . ttf " , 
$Conf ig{Font_Size} , 0, $x2+lo, $y2-3, jJNeg"); 

} 

} 

#CEBP mutant to go in! 

#Now something similar for classification #8 (CEBP) : 

$xl=$xl + $Conf ig{Graph_Sp / ace} ; #ie. give some space between the two scales 

my $CEBP_Class = $ Classification's { $Patient_ID{$row} } ; 

print »D: CEBP Class = /$CEBP_Class • for Patient: ' $Patient_ID { $row} ' \n» ; 
if ($CEBP_Class eq "») 

{ 

print "D: Missing CEBP Classification: Drawing a cross\n" ; 
$x2 = $xl + /$Conf icj{Block_Size} ; 
$Image -> lame ($xl, $yl, $x2, $y2, $Black) ; 
$Image -> ^.ne ($x2, $yl, $xl, $y2, $Black) ; 

} 

else 

{ 

if ($CEBP_Class = ~ m/Pos/i or $CEBP_Class =~ m/Yes/i) 

'{ 

$x2=$xl + 150; 

$Xmage -> f illedRectangle ($xl, $yl, $x2, $y2, $Sof t_Red) ; 
$Image -> stringTTF ($Black, /fonts/Courier . ttf " , 
$Conf ig{Font_Size}/ 0, $x2 + 10, $y2-2, "Pos"); 

} 

else 

{ 

$X2 = $X1 + 75; 

$lmage -> f illedRectangle ($xl, $yl, $x2, $y2, $Soft_Green) ; 

$Image -> stringTTF ($Black, " . /fonts/Courier . ttf " , 
$Config{ Font /Size}, 0, $x2+10 f $y2-3, "Neg") ; 

} } 

next; " >j-k 

) I 

#return (f$Cat bottom color, $Number of colors) ; 
sub Draw_blood_bar { 

{my $color, my $Count, my $x, my $y, my $Length) = @__ ; 

$lmage -> f illedRectangle ($x, $y, $x + — " fc " " '"~ * Size}-1, $color) ; 
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$Image -> stringTTF (l, » . /f onts/Courier . ttf " , $Conf ig{Font_Size} , 0, $x + $Length + 10, $y 
+ $Config{Block_Size}-l, int ($ Count) ) 

} 

################START SUB 

#sub Draw_Classif i cat ion__S tripe { 

#Er? Finishing this would be a good idea .... 

#Hey! This doesn't do anything! 

#for my $C_Class (1 . . $Classes) 

t { 
# ) 



sub Label__Class { 
(my $x, my $y, my $Cat) = ©_; 
print "D: LABEL_CLASS : Got the dat 

} 



a: [X,Y,Cat] * $x'/, ' $y», « $Cat» passed\n» ; 



sub Top_Color_Print { 

print "D: [Allocating new color of in< 

$Top_Color ++ ; 

} 



ix : ' $Top_Color 1 ] \n" ; 



# Cycle through all 



sub Allocate_Catergory_range { 
my %C1 asses; 

my $Number_of_Classes=0 ,* 

foreach my $C__Patient (keys %Class±f^cation_l) 
classifications 

{ 

# print °D: Classification of/ Patient: 1 $C_Patient f = 
' $Classif ication_l { $C_Patient } ' \n"/; 

unless (exists $Classes{ $qflLassif ication_l {$C_Patient } } ) #Check whether this 

classification has been seen bef( 

{ / #Ok, it hasn't: 

print "D: Found new Class: ' $Classif ication_l { $C_Patient } 1 \n tt ; 
$Classes { $Classif ication_l { $C_Patient } } = $Classif icationJL { $C_Patient } ; 
#Add it to the Hash Array 

$Number_of_Clas / ses -4-+; #Add 1 to the tally of classes 

} 7 

print "D: Number of FAB Classes (patient catergories) = • $Number__of_Cl asses 1 \n« ; ^Useful to 
know j 

print "D : Allocate 1 Catergory Colors 1 : \n" ; 

my $CC_max_color = $#Color_Stripe ; 

my $Cat_bottom_color = $CC_max_color + 3; 

print "D: Last Color Allocated for- CC Matrix: $CC_max_color 1 $Cat_bottom_color ' \n" ; 
my $Number_of_colors - $Number_of_Cl asses -3; 

foreach my $C Color (0 /. $Number_of _colors) #Ie, pickup where the CC data left off 

{ / 

printf ("%3i % $C_Color) ; 

my $Red_level/= int (255 / $Number__of_colors * $C_Color) ; #The (complex) 
calculation for the /color level 

print »D: For $C_Color: RecL_level (needed to alter Green to Yellow) = 1 $Red__level ' , 
i.e. Color :", ($CQolor+ $Cat_bott om_color) , "\n M ; itworks for the red as well but 

without the "255?" part 

# push @Color_Stripe # 

$ Image -> colorAllocate ($Red_level , 255 , 0) ; 

) 

my $Cat_top_color = $#Color_Stripe ; j}Don't think this is actually used... nice to 

know though! 

print "D: Catergory colors will range from: $Cat_bottom_color to ' " , $Cat_bottom_color + 
$Number_pf_colors, " • \n rt ; 

} 



Figure 15o 



